home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 July / EnigmA AMIGA RUN 20 (1997)(G.R. Edizioni)(IT)[!][issue 1997-07 & 08][EAR-CD IV].iso / earcd / dev / amos / moreusel.lha / Diskcruncher.AMOS / Diskcruncher.amosSourceCode < prev   
AMOS Source Code  |  1997-04-18  |  7KB  |  271 lines
  1. Screen Open 0,640,200,4,$8000
  2. Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  3. Palette 0,$FFF,$F00,$F0,$F,$F0F,$FF0,$FF,$222,$F80,$F8
  4. Dim REGS(10)
  5. Global GOT$,LVO,RES,LIB$,LIB,FUNK,BASE,REGS()
  6. LVO=0 : DIO=0
  7. CLEARALL
  8. TRACK$="trackdisk.device"+Chr$(0)
  9. Gosub INIT
  10. Gosub OPENDEVICE
  11. If RES Then Print "Error opening "+TRACK$+"!!!" : CLOSALL : End 
  12. Reserve As Work 12,1760*516
  13. BIGBASE=Start(12)
  14. Reserve As Work 11,1760
  15. BITST=Start(11)
  16. Reserve As Work 10,512*11
  17. AD=Start(10)
  18. STT=0
  19. Gosub MOTORON
  20. A=0
  21. OS=880*512 : LE=512
  22. Gosub REEDBLOCK
  23. If Leek(AD+312)<>-1 Then Print "Disk not validated!" : Gosub QUIT : End 
  24. BITMAP=Leek(AD+316)
  25. Print "Bitmapblock:";BITMAP
  26. OS=BITMAP*512 : LE=512
  27. Gosub REEDBLOCK
  28. USED=0
  29. X=0 : Y=0
  30. For A=0 To 1759
  31.   P=Leek(AD+(A+30)/32*4)
  32.   B=Btst((A+30) mod 32,P)
  33.   If A/2=0 Then B=0
  34.   If B=0 Then Inc USED
  35.   Poke BITST+A,B+1
  36.   Ink B+2
  37.   Bar(A/22)*8,(A mod 22)*8 To(A/22)*8+6,(A mod 22)*8+6
  38. Next 
  39. Print "Blocks used:";USED
  40. LX=BIGBASE
  41. For A=0 To 1759
  42.   If Peek(BITST+A)=1 Then Gosub CRUNCHNSAVE
  43.   If Inkey$<>"" Then Exit 
  44. Next 
  45. Bsave "ram:Disk.dcr",BIGBASE To LX
  46. Gosub QUIT
  47. End 
  48. CRUNCHNSAVE:
  49.   Doke LX,A : Add LX,2
  50.   OS=A*512 : LE=512 : Gosub REEDBLOCK
  51.   Copy AD,AD+512 To AD+512
  52.   UN= Extension_5_00CE(AD+512,512,1,2048,0)
  53.   If UN<1
  54.     Print "Block";A;" not crunched!"
  55.     Doke LX,$FFFF : Add LX,2
  56.     Copy AD,AD+512 To LX : Add LX,512
  57.   Else 
  58.     Print "Block";A;" crunched to";UN;" bytes len!"
  59.     Doke LX,UN : Add LX,2
  60.     Copy AD+512,AD+512+UN To LX : Add LX,UN
  61.   End If 
  62. Return 
  63. QUIT:
  64.   Gosub MOTOROFF
  65.   Gosub CLOSDEVICE
  66.   CLOSALL
  67. Return 
  68. INIT:
  69.   LAUFWERK=0
  70.   Reserve As Chip Work 9,128
  71.   OPENLIB["exec"]
  72.   LIPCALL1["exec","FindTask",0]
  73.   TASK=RES
  74.   ST=Start(9)
  75.   For A=1 To Len(TRACK$)
  76.     Poke ST+89+A,Asc(Mid$(TRACK$,A,1))
  77.   Next 
  78.   TRACK=ST+90
  79.   DISKPORT=ST
  80.   Loke ST,0 : Loke ST+4,0 : Doke ST+8,$400 : Loke ST+10,0
  81.   Doke ST+14,31 : Loke ST+16,TASK : Loke ST+20,ST+24
  82.   Loke ST+24,0 : Loke ST+28,ST+20 : Doke ST+32,0
  83.   DISKIO=ST+34
  84.   Loke ST+34,0 : Loke ST+38,0 : Doke ST+42,$500 : Loke ST+44,0
  85.   Loke ST+48,DISKPORT : Doke ST+52,48
  86.   For A=0 To 8
  87.     Loke ST+54+A*4,0
  88.   Next 
  89. Return 
  90. OPENDEVICE:
  91.   DIO=0
  92.   LIPCALL4["exec","OpenDevice",TRACK,LAUFWERK,DISKIO,0]
  93. Return 
  94. MOTORON:
  95.   Doke DISKIO+28,9
  96.   Loke DISKIO+36,1
  97.   If DIO=0 Then LIPCALL1["exec","DoIO",DISKIO] : DIO=1 Else LCALL
  98. Return 
  99. MOTOROFF:
  100.   Doke DISKIO+28,9
  101.   Loke DISKIO+36,0
  102.   If DIO=0 Then LIPCALL1["exec","DoIO",DISKIO] : DIO=1 Else LCALL
  103. Return 
  104. REEDBLOCK:
  105.   Doke DISKIO+28,2
  106.   Loke DISKIO+36,LE
  107.   Loke DISKIO+40,AD
  108.   Loke DISKIO+44,OS
  109.   If DIO=0 Then LIPCALL1["exec","DoIO",DISKIO] : DIO=1 Else LCALL
  110. Return 
  111. CLOSDEVICE:
  112.   DIO=0
  113.   LIPCALL1["exec","CloseDevice",DISKIO]
  114. Return 
  115. End 
  116. Procedure LIPCALL0[N$,F$]
  117.   LIB$=N$ : LIBGET[F$]
  118.   LCALL
  119. End Proc
  120. Procedure LIPCALL1[N$,F$,R1]
  121.   LIB$=N$ : LIBGET[F$]
  122.   REGS(1)=R1
  123.   LCALL
  124. End Proc
  125. Procedure LIPCALL2[N$,F$,R1,R2]
  126.   LIB$=N$ : LIBGET[F$]
  127.   REGS(1)=R1 : REGS(2)=R2
  128.   LCALL
  129. End Proc
  130. Procedure LIPCALL3[N$,F$,R1,R2,R3]
  131.   LIB$=N$ : LIBGET[F$]
  132.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3
  133.   LCALL
  134. End Proc
  135. Procedure LIPCALL4[N$,F$,R1,R2,R3,R4]
  136.   LIB$=N$ : LIBGET[F$]
  137.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4
  138.   LCALL
  139. End Proc
  140. Procedure LIPCALL5[N$,F$,R1,R2,R3,R4,R5]
  141.   LIB$=N$ : LIBGET[F$]
  142.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
  143.   LCALL
  144. End Proc
  145. Procedure LIPCALL6[N$,F$,R1,R2,R3,R4,R5,R6]
  146.   LIB$=N$ : LIBGET[F$]
  147.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
  148.   REGS(6)=R6
  149.   LCALL
  150. End Proc
  151. Procedure LIPCALL7[N$,F$,R1,R2,R3,R4,R5,R6,R7]
  152.   LIB$=N$ : LIBGET[F$]
  153.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
  154.   REGS(6)=R6 : REGS(7)=R7
  155.   LCALL
  156. End Proc
  157. Procedure LIPCALL8[N$,F$,R1,R2,R3,R4,R5,R6,R7,R8]
  158.   LIB$=N$ : LIBGET[F$]
  159.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
  160.   REGS(6)=R6 : REGS(7)=R7 : REGS(8)=R8
  161.   LCALL
  162. End Proc
  163. Procedure LIPCALL9[N$,F$,R1,R2,R3,R4,R5,R6,R7,R8,R9]
  164.   LIB$=N$ : LIBGET[F$]
  165.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
  166.   REGS(6)=R6 : REGS(7)=R7 : REGS(8)=R8 : REGS(9)=R9
  167.   LCALL
  168. End Proc
  169. Procedure LIPCALL10[N$,F$,R1,R2,R3,R4,R5,R6,R7,R8,R9,R10]
  170.   LIB$=N$ : LIBGET[F$]
  171.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
  172.   REGS(6)=R6 : REGS(7)=R7 : REGS(8)=R8 : REGS(9)=R9 : REGS(10)=R10
  173.   LCALL
  174. End Proc
  175. Procedure LIBGET[FUNK$]
  176.   ST=Start(15) : LIBS=Leek(ST)
  177.   LIB$=LIB$-".library"+".library"
  178.   FUNK$=Upper$(FUNK$)
  179.   For A=1 To LIBS
  180.     BIN[ST+Leek(ST+A*8-4)]
  181.     If LIB$=GOT$ Then Exit 
  182.   Next 
  183.   If A=LIBS+1 Then Print "FEHLER: Library nicht in LibCall.Dat!" : End 
  184.   If Leek(ST+A*8)=0 Then Print "FEHLER: Library nicht offen!" : End 
  185.   LIB=A
  186.   BASE=ST+Leek(ST+A*8-4)
  187.   For A=1 To Deek(BASE+24)
  188.     BIN[BASE-12+A*44-LVO*4]
  189.     If Upper$(GOT$)=FUNK$ Then Exit 
  190.   Next 
  191.   If A=Deek(BASE+24)+1 Then Print "FEHLER: Funktion nicht gefunden!" : End 
  192.   FUNK=A
  193. End Proc
  194. Procedure LCALL
  195.   For A=1 To 8
  196.     R=Peek(BASE+17+A+FUNK*44)
  197.     If R>0 Then Loke Start(14)+R*4-4,REGS(A)
  198.   Next 
  199.   OFF=-Deek(BASE+16+FUNK*44)
  200.   Loke Start(14)+60,Leek(Start(15)+LIB*8)+OFF
  201.   Loke Start(14)+56,Leek(Start(15)+LIB*8)
  202.   Call Start(14)+64
  203.   RES=Leek(Start(14))
  204. End Proc
  205. Procedure OPENLIB[N$]
  206.   If Length(15)=0
  207.     Open In 1,"dh1:amos/fertig/libcall/LibCall.dat" : L=Lof(1) : GOT$=Input$(1,8) : Close 1
  208.     Reserve As Data 15,L
  209.     Bload "dh1:amos/fertig/libcall/LibCall.dat",15
  210.   End If 
  211.   ST=Start(15) : LIBS=Leek(ST)
  212.   N$=N$-".library"+".library"
  213.   For A=1 To LIBS
  214.     BIN[ST+Leek(ST+A*8-4)]
  215.     If N$=GOT$ Then Exit 
  216.   Next 
  217.   If A=LIBS+1 Then Print "FEHLER: Library nicht in LibCall.Dat!" : End 
  218.   If Leek(ST+A*8)<>0 Then Pop Proc
  219.   If N$="exec.library" Then Loke ST+A*8,Leek(4) : Pop Proc
  220.   Areg(1)=ST+Leek(ST+A*8-4)
  221.   Dreg(0)=0
  222.   Loke ST+A*8,Execall(-552)
  223.   If Leek(ST+A*8)=0 Then Print "FEHLER: Library konnte nicht ge�ffnet werden!" : End 
  224. End Proc
  225. Procedure CLEARALL
  226.   If Length(15)=0 Then Pop Proc
  227.   ST=Start(15)
  228.   For A=1 To Leek(ST)
  229.     Loke ST+A*8,0
  230.   Next 
  231. End Proc
  232. Procedure CLOSLIB[N$]
  233.   If Length(15)=0 Then Print "FEHLER: LibCall.Dat nicht geladen -> keine Library offen!"
  234.   ST=Start(15) : LIBS=Leek(ST)
  235.   N$=N$-".library"+".library"
  236.   For A=1 To LIBS
  237.     BIN[ST+Leek(ST+A*8-4)]
  238.     If N$=GOT$ Then Exit 
  239.   Next 
  240.   If A=LIBS+1 Then Print "FEHLER: Library nicht in LibCall.Dat!" : End 
  241.   If Leek(ST+A*8)=0 Then Pop Proc
  242.   If N$="exec.library" Then Loke ST+A*8,0 : Pop Proc
  243.   Areg(1)=Leek(ST+A*8)
  244.   AD=Execall(-414)
  245.   Loke ST+A*8,0
  246. End Proc
  247. Procedure CLOSALL
  248.   If Length(15)=0 Then Print "FEHLER: LibCall.Dat nicht geladen -> keine Library offen!"
  249.   ST=Start(15) : LIBS=Leek(ST)
  250.   For A=1 To LIBS
  251.     BIN[ST+Leek(ST+A*8-4)]
  252.     If(GOT$<>"exec.library") and(Leek(ST+A*8)<>0)
  253.       Areg(1)=Leek(ST+A*8)
  254.       AD=Execall(-414)
  255.       Loke ST+A*8,0
  256.     Else 
  257.       Loke ST+A*8,0
  258.     End If 
  259.   Next 
  260. End Proc
  261. Procedure GEREG[REGNUM]
  262.   RES=Leek(Start(14)+REGNUM*4)
  263. End Proc
  264. Procedure BIN[AD]
  265.   GOT$=""
  266.   Do 
  267.     CO=Peek(AD) : Inc AD
  268.     Exit If CO=0
  269.     GOT$=GOT$+Chr$(CO)
  270.   Loop 
  271. End Proc